TP3

Axel Fridman

L.U : 527/20

Buscamos primero cargar todos los datos.

install.packages("plotly")

Error in install.packages : Updating loaded packages

install.packages("rgl")

Error in install.packages : Updating loaded packages

install.packages("plot3D")

Error in install.packages : Updating loaded packages

install.packages(tidyverse)

Error in install.packages : object 'tidyverse' not found

install.packages(dplyr)

Error in install.packages : object 'dplyr' not found

install.packages(GGally)

Error in install.packages : object 'GGally' not found

library("plotly")
library("plot3D")
library(tidyverse) # entorno tidy
library(dplyr) # manejo de datos
library(GGally) # scatterplots multiples
library(rgl) # para graficos 3D
df = read.csv("datos_alquiler.csv", stringsAsFactors = F)

Vemos todos los atributos de cada propiedad

colnames(df)

 [1] "id"              "start_date"      "lat"             "lon"             "l1"              "l2"              "rooms"           "surface_total"  
 [9] "surface_covered" "price"           "currency"        "property_type"   "operation_type"  "fondo"          

table(df$property_type)

        Casa Departamento           PH 
          27         1828           90 

mayor = quantile(df$surface_total, 0.99)
label = "Superficies "
hist(df$surface_total, breaks = 100,  freq = F, xlab = label, xlim = c(0,mayor), main ="")

Hay un pico alrededor de 40-50m2 y luego un lento descenso de cantidad de casas con mayor superficie. Quite las 1% mas espaciosas.

variables_Interes = c("price", "rooms", "surface_total", "fondo", "lat", "lon")
labelsInteres = c("Precio", "Habitaciones", "Superficie total", "Fondo", "lat", "lon")
variables_Interes2 = c("property_type", "start_date")
par(mfrow=c(2,4))
breaksVector = c(40,20,50,35,20,20)
plot(df[,variables_Interes[5]], df[,variables_Interes[6]], xlab = "Longitud", ylab = "Latitud")
for (i in 1:length(variables_Interes)) {
  #mayor = quantile(df[,variables_Interes[i]], 1, na.rm=T)
  label = labelsInteres[i]
  hist(df[,variables_Interes[i]], breaks = breaksVector[i],  freq = F, xlab = label, main ="")
}

with(df,{
  
tiposProp = table(property_type)
prop.table(table(tiposProp))
barplot(tiposProp, las=2, cex.names=0.65)
})

Parece haber 3 zonas muy distintas. La mayoria de las casas tienen entre 1 y 3 habitaciones. Estamos hablando de analizar un dataset con una absoluta mayoria de departamentos en vez de casas y phs.

df$start_date = as.Date(df$start_date)
df$diaEsp = factor(weekdays(df$start_date), levels = c("lunes", "martes", "miércoles", "jueves", "viernes","sábado", "domingo"))
df$mesEsp = factor(months(df$start_date), levels= c("enero", "febrero", "marzo", "junio", "julio","agosto", "septiembre", "octubre", "noviembre", "diciembre"))
df$diaIng = factor(weekdays(df$start_date), levels = c("Monday", "Tuesday","Wednesday", "Thursday", "Friday", "Saturday","Sunday"))
df$mesIng = factor(months(df$start_date), levels= c("January", "February", "March","April","May", "June", "July","August", "September", "October", "November", "December"))

with(df,{
par(mfrow=c(1,2))

dias = table(diaEsp) #Poner diaIng o diaEsp segun corresponda
prop.table(table(dias))
barplot(dias, las=2, cex.names=0.65)
meses = table(mesEsp) #Poner mesIng o mesEsp segun corresponda
prop.table(table(meses))
barplot(meses, las=2, cex.names=0.65, )
})

ajusM1<-lm(price~1,data=df)
coe<-coef(ajusM1)
plot(df$price,  xlab = "Propiedades", ylab = "Precio")
abline(h = coe[1], col='red')

abline(h = quantile(df$price, 0.95), col='blue')

#h = lm(id ~ -1, data=df)

Como la linea roja viene de un modelo con un parametro constante que no depende de ninguna variable explicativa es el promedio (con loss function suma de diferencia de cuadrados). Podemos ver que la mayoria de las propiedades (el 95%) estan concentradas por debajo de la linea azul. Mientras que el 5% de propiedades mas caras empujan el promedio (linea roja) ligeramente arriba del centro de la nube negra de propiedades. Es decir el 5% de propiedades mas caras ocupa mas de la mitad del grafico.

with(df,{
par(mfrow=c(1,3))
  
plot(price~surface_covered, xlab ='Superficie cubierta', ylab = 'Precio')
precioSupC<-lm(price~surface_covered,data=df)
coeSP<-coef(precioSupC)
abline(coeSP, col = 'red')

plot(price~fondo, xlab ='Fondo', ylab = 'Precio')
precioFon<-lm(price~fondo,data=df)
coeFP<-coef(precioFon)
abline(coeFP, col = 'red')

plot(price~start_date, xlab ='Fecha de pub', ylab = 'Precio')
precioFecha<-lm(price~start_date,data=df)
coeFech<-coef(precioFecha)
abline(coeFech, col = 'red')
})

A los datos me remito, es muchisimo mas clara la relacion entre superficie cubierta y precio, que precio y fondo. Ni que hablar fecha de publicacion, en el cual se ve que mi coeficiente de grado 1 es practicamente 0. Con lo cual obtenemos algo similar al promedio de fecha de publicacion.

precioSupC<-lm(price~surface_covered,data=df)
precioFecha<-lm(price~start_date,data=df)
precioFon<-lm(price~fondo,data=df)

summary(precioSupC)

Call:
lm(formula = price ~ surface_covered, data = df)

Residuals:
   Min     1Q Median     3Q    Max 
-20670  -2470   -581   1833  40857 

Coefficients:
                Estimate Std. Error t value Pr(>|t|)    
(Intercept)     5168.986    244.641   21.13   <2e-16 ***
surface_covered  231.388      4.212   54.93   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 4579 on 1943 degrees of freedom
Multiple R-squared:  0.6083,    Adjusted R-squared:  0.6081 
F-statistic:  3018 on 1 and 1943 DF,  p-value: < 2.2e-16

summary(precioFon)

Call:
lm(formula = price ~ fondo, data = df)

Residuals:
   Min     1Q Median     3Q    Max 
-18612  -4544  -1935   2543  47412 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 16544.01     181.19   91.31   <2e-16 ***
fondo         130.45      13.35    9.77   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 7142 on 1943 degrees of freedom
Multiple R-squared:  0.04682,   Adjusted R-squared:  0.04633 
F-statistic: 95.45 on 1 and 1943 DF,  p-value: < 2.2e-16

summary(precioFecha)

Call:
lm(formula = price ~ start_date, data = df)

Residuals:
   Min     1Q Median     3Q    Max 
 -9575  -5049  -2136   2648  47722 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)
(Intercept) -40616.288  59867.212  -0.678    0.498
start_date       3.223      3.329   0.968    0.333

Residual standard error: 7314 on 1943 degrees of freedom
Multiple R-squared:  0.0004821, Adjusted R-squared:  -3.235e-05 
F-statistic: 0.9371 on 1 and 1943 DF,  p-value: 0.3331

El R de cada modelo esta ordenado como el grafico. Superf cub > fondo > fecha de pub Notado que de los residuos, el mediano es siempre negativo, puedo deducir que el modelo esta prediciendo que el elemento del medio deberia ser mas grande que el que es. Esto puede deberse a la influencia de lo mucho mayor que es el precio cuando la superficie es mas grande, lo cual podria deberse a que el modelo lineal no se ajusta del todo bien por como estan distribuidos los precios en relacion a la sup.

summary(precioSupC$residuals)

    Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
-20669.9  -2469.8   -581.5      0.0   1833.1  40857.2 

summary(precioFon$residuals)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
 -18612   -4544   -1935       0    2543   47412 

summary(precioFecha$residuals)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  -9575   -5049   -2136       0    2648   47722 

#sqrt(sum((precioSupC$residuals)**2))

plot(df$surface_covered, df$price, col='red', ylim = c(0 , 1.5*max(predict(precioSupC))), xlab = 'Superficie cubierta', ylab = 'Precio')
points( df$surface_covered, predict(precioSupC), col='blue')

La prediccion en azul mientras que los datos en rojo. Se puede ver como la ‘dispersion’ de los precios de superficie mas baja es menor, entonces uno puede tener una mejor prediccion, mientras que si aumenta mucho la superficie la variabilidad del precio es mayor, y el modelo le pifia mas.

desempenioHastaPorcentaje = function(porcentaje){
  sup = quantile(df$surface_covered, porcentaje)
  sups = df[df$surface_covered <= sup,]$surface_covered
  precio = df[df$surface_covered <= sup,]$price
  modelo<-lm(precio~sups,data=df)
  return(summary(lm(precio~sups, data=df))$r.squared)
  
}

porcentajes = c(1:100)/100
plot(sapply(porcentajes, desempenioHastaPorcentaje), xlab = 'Porcentaje del dataset evaluado en modelo', ylab = 'Error del modelo en R cuadrado')

Claramente el error crece raoidamente y “de a saltos” a medida que tomo un mayor porcentaje de los datos.

par(mfrow=c(1,3))
plot(precioSupC$residuals, xlab = 'Residuos superficie cubierta', ylab = 'Residuos')
abline(h=0,col= 'red')

plot(precioFon$residuals, xlab = 'Residuos fondo', ylab = 'Residuos')
abline(h=0,col= 'red')

plot(precioFecha$residuals, xlab = 'Residuos fecha de pub', ylab = 'Residuos')
abline(h=0,col= 'red')

Tal como esperabamos, el promedio del modulo los residuos es mas chico en superifice cubierta (grafico mas comprimido en 0) mientras que va aumentando debido a mayores diferencias al 0 en los otros graficos.

modeloPrecioTiempo = lm(price~start_date, data = df)
plot(df$price~df$start_date, xlab="Fecha", ylab="Precio")
abline(coef(modeloPrecioTiempo), col='red')

No se aprecia la inflacion, es practicamente una constante.

modeloPrecioTipoPropiedad = lm(price~property_type, data = df)
boxplot(df$price~df$property_type)
coefProp = coef(modeloPrecioTipoPropiedad)
abline(modeloPrecioTipoPropiedad)

Warning in abline(modeloPrecioTipoPropiedad) :
  only using the first two of 3 regression coefficients

print(coefProp)

              (Intercept) property_typeDepartamento           property_typePH 
                22981.481                 -5852.160                 -3103.704 

Lo que este modelo nos dice es que las casas por el simple hecho de ser casas tienen un valor promedio de 22981 (que actua como una ‘base’ para el resto de las propiedades. Mientras que ser un departamento te penaliza por -5852 menos el precio relativo a una casa y ser un PH tambien te penaliza por -3103. El modelo que hice solamente conecta precio de Casa vs Departamento

zonas = kmeans(df$lat + df$lon, 3, iter.max = 50)

colores = c('red','green', 'blue')
plot(df$lat, df$lon, col=colores[zonas$cluster])

Dividimos por zona segun ubicacion, y nos fijamos que modelo ajusta mejor a cada zona particular

modelo1 = lm(price~surface_covered+rooms, data = df[zonas$cluster==1,])
modelo2 = lm(price~surface_covered+rooms, data = df[zonas$cluster==2,])
modelo3 = lm(price~surface_covered+rooms, data = df[zonas$cluster==3,])

par(mfrow=c(2,3))
plot(df[zonas$cluster==1,]$lat, df[zonas$cluster==1,]$lon, col=colores[1])
plot(df[zonas$cluster==2,]$lat, df[zonas$cluster==2,]$lon, col=colores[2])

plot(df[zonas$cluster==3,]$lat, df[zonas$cluster==3,]$lon, col=colores[3])
scatter3D(df[zonas$cluster==1,]$surface_covered, df[zonas$cluster==1,]$rooms, df[zonas$cluster==1,]$price, colvar = df[zonas$cluster==1,]$price, col = 2, add = F,xlab = 'Sup Cub', ylab= 'Hab', zlab = 'Precio')

scatter3D(df[zonas$cluster==2,]$surface_covered, df[zonas$cluster==2,]$rooms, df[zonas$cluster==2,]$price, colvar = df[zonas$cluster==2,]$price, col = 3, add = F,xlab = 'Sup Cub', ylab= 'Hab', zlab = 'Precio')
scatter3D(df[zonas$cluster==3,]$surface_covered, df[zonas$cluster==3,]$rooms, df[zonas$cluster==3,]$price, colvar = df[zonas$cluster==3,]$price, col = 4, add = F, xlab = 'Sup Cub', ylab= 'Hab', zlab = 'Precio')

#set.seed(417)
#temp <- rnorm(100, mean=30, sd=5)
#pressure <- rnorm(100)
#dtime <- 1:100
#plot_ly(x=df[zonas$cluster==1,]$surface_covered, y=df[zonas$cluster==1,]$rooms, z=df[zonas$cluster==1,]$price, type="scatter3d", mode="markers", color=0.3)

Superficie = df$surface_covered
Habitaciones = df$rooms
Precio = df$price
colores2 = c("IndianRed", "MediumPurple", "DarkOrange")
#color=colores[zonas$cluster]

fig <- plot_ly(x=~Superficie, y=~Habitaciones, z=~Precio, type="scatter3d", mode="markers", marker = list(color = colores[zonas$cluster], showscale = F),xlab = 'Sup Cub', ylab= 'Hab', zlab = 'Precio', size = 1)
fig <- fig %>% layout(title = '3 zonas distribuicion',
         xaxis = list(title = 'Superficie cubierta',
                      zeroline = TRUE,
                      range = c(0, 250)),
         yaxis = list(title = 'Habitaciones',
                      range = c(0,1400)))

fig

Warning: Ignoring 166 observations
Warning: 'scatter3d' objects don't have these attributes: 'xlab', 'ylab', 'zlab'
Valid attributes include:
'connectgaps', 'customdata', 'customdatasrc', 'error_x', 'error_y', 'error_z', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'legendgroup', 'legendgrouptitle', 'legendrank', 'line', 'marker', 'meta', 'metasrc', 'mode', 'name', 'opacity', 'projection', 'scene', 'showlegend', 'stream', 'surfaceaxis', 'surfacecolor', 'text', 'textfont', 'textposition', 'textpositionsrc', 'textsrc', 'texttemplate', 'texttemplatesrc', 'transforms', 'type', 'uid', 'uirevision', 'visible', 'x', 'xcalendar', 'xhoverformat', 'xsrc', 'y', 'ycalendar', 'yhoverformat', 'ysrc', 'z', 'zcalendar', 'zhoverformat', 'zsrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'

Warning: Ignoring 166 observations
Warning: 'scatter3d' objects don't have these attributes: 'xlab', 'ylab', 'zlab'
Valid attributes include:
'connectgaps', 'customdata', 'customdatasrc', 'error_x', 'error_y', 'error_z', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'legendgroup', 'legendgrouptitle', 'legendrank', 'line', 'marker', 'meta', 'metasrc', 'mode', 'name', 'opacity', 'projection', 'scene', 'showlegend', 'stream', 'surfaceaxis', 'surfacecolor', 'text', 'textfont', 'textposition', 'textpositionsrc', 'textsrc', 'texttemplate', 'texttemplatesrc', 'transforms', 'type', 'uid', 'uirevision', 'visible', 'x', 'xcalendar', 'xhoverformat', 'xsrc', 'y', 'ycalendar', 'yhoverformat', 'ysrc', 'z', 'zcalendar', 'zhoverformat', 'zsrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'

modelo1$coefficients

    (Intercept) surface_covered           rooms 
      6313.4677        216.6692        361.9120 

plot3d(modelo1,size=15,col="red")

modelo2$coefficients

    (Intercept) surface_covered           rooms 
      4207.1741        189.3097        318.0363 

plot3d(modelo2,size=15,col="green")

modelo3$coefficients

    (Intercept) surface_covered           rooms 
      3811.1068        237.6054        734.1301 

plot3d(modelo3,size=15,col="blue")

De los coeficientes de cada modelo segun la zona podemos ver que las habitaciones suman mucho mas en una de las 3 zonas. Por otro lado hay otra zona distinta que es mas cara a ‘0 hab y 0 superficie’. En cuanto a cuanto cuesta el m2 cuadrado cubierto en cada zona es similar.

Construya una gráfica que muestre el error de ajuste en función de la cantidad de parámetros de cada modelo. Cuál modelo tiene menor error de ajuste?

modeloSimple0 = lm(price~surface_covered + fondo, data = df)
modeloSimple1 = lm(price~surface_covered +fondo, data = df)
modeloSimple2 = lm(price~surface_covered +fondo+property_type, data = df)
modeloSimple3 = lm(price~surface_covered +fondo+property_type+lat+lon, data = df)
modeloSimple4 = lm(price~surface_covered +fondo+property_type+lat+lon+start_date, data = df)
modeloCompleto = lm(price~surface_covered +fondo+property_type+lat+lon+start_date+rooms, data = df)
coefR = c(summary(modeloSimple0)$r.squared,summary(modeloSimple1)$r.squared,summary(modeloSimple2)$r.squared,summary(modeloSimple3)$r.squared,summary(modeloSimple4)$r.squared,summary(modeloCompleto)$r.squared)

plot(c(1:6), coefR, xlab = 'Modelo', ylab=' Coeficiente R cuadrado')

Podemos ver como progresa el R cuadrado cuando vamos sumando variables explicativas, notese como sumar la fecha de publicacion y habitaciones no cambia practicamente nada, ya que 4 y 5 y 6 son casi identicos. Lo mismo con 1, 2 y 3, property type y fondo no redujeron mucho el error del modelo. Esto nos dice que para minimizar el error de ajuste hay que sumar variables explicativas, pero no cualquiera, ya que en este caso la fecha fue un pesimo indicador. El quiebre se produce cuando consideramos latitud y longitud.